home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyAEUtils.p < prev    next >
Encoding:
Text File  |  1994-10-31  |  18.4 KB  |  637 lines  |  [TEXT/PJMM]
  1. unit MyAEUtils;
  2.  
  3. interface
  4.  
  5.     uses
  6. {$IFC undefined THINK_Pascal}
  7.         TextEdit, 
  8. {$ENDC}
  9.         AppleEvents;
  10.  
  11.     const
  12.         typeMyPropertyToken = 'PTok';
  13.         myPropertiesResType = 'MPRP';
  14.  
  15.     type
  16.         SuspendedEvent = record
  17.                 waiting: boolean;
  18.                 event, reply: AppleEvent;
  19.                 dispatcher: EventHandlerProcPtr;
  20.                 refcon: longInt;
  21.             end;
  22.  
  23.     procedure InitAEUtils (GetPropertyFromContainer, SetPropertyFromContainer: ProcPtr);
  24. {  function GetPropertyFromContainer (prop: DescType; container: AEDesc; var result: AEDesc): OSErr;}
  25. {    function SetPropertyFromContainer (prop: DescType; container: AEDesc; value: AEDesc): OSErr;}
  26.  
  27.     function GotRequiredParams (theAppleEvent: AppleEvent): OSErr;
  28.  
  29.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: ptr; maximumSize: Size; var actualSize: Size): OSErr;
  30.  
  31.     procedure AECreate (var desc: AEDesc);
  32.     procedure AEDestroy (var desc: AEDesc); { dispose without error }
  33.     function AENull: AEDesc;
  34.  
  35.     function CreateStringDesc (s: str255; var desc: AEDesc): OSErr;
  36.     function CreateLongDesc (n: longInt; var desc: AEDesc): OSErr;
  37.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  38.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  39.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  40.  
  41.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  42.  
  43. { Guarentteed to preserve x on error }
  44.     function GetStringFromAEDesc (desc: AEDesc; var x: str255): OSErr;
  45.     function GetLongFromAEDesc (desc: AEDesc; var x: longInt): OSErr;
  46.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  47.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  48.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  49.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  50.  
  51. { Guarentteed to preserve x on error }
  52.     function GetStringFromAERecord (desc: AERecord; key: AEKeyword; var x: str255): OSErr;
  53.     function GetLongFromAERecord (desc: AERecord; key: AEKeyword; var x: longInt): OSErr;
  54.     function GetTypeFromAERecord (desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  55.     function GetBooleanFromAERecord (desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  56.     function GetFSSpecFromAERecord (event: AppleEvent; key: AEKeyword; var x: FSSpec): OSErr;
  57.     function GetEnumeratedFromAERecord (event: AppleEvent; key: AEKeyword; var x: DescType): OSErr;
  58.  
  59.     function PutTESelectionToAERecord (desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  60.     function PutStringToAERecord (desc: AERecord; key: AEKeyword; s: str255): OSErr;
  61.     function PutLongToAERecord (desc: AERecord; key: AEKeyword; n: longInt): OSErr;
  62.     function PutDateToAERecord (desc: AERecord; key: AEKeyword; date: longInt): OSErr;
  63.     function PutTypeToAERecord (desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  64.     function PutBooleanToAERecord (desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  65.     function PutFSSpecToAERecord (desc: AppleEvent; key: AEKeyword; fs: FSSpec): OSErr;
  66.  
  67.     function MyOAFindProperty (desiredClass: DescType; containerToken: AEDesc; containerClass: DescType; keyForm: DescType; keyData: AEDesc; var token: AEDesc; refcon: LongInt): OSErr;
  68.     function SetPropertyFromToken (token: AEDesc; value: AEDesc): OSErr;
  69.     function SetPropertyRecord (token: AEDesc; value: AEDesc): OSErr;
  70.     function GetPropertyFromToken (token: AEDesc; var result: AEDesc): OSErr;
  71.     function GetPropertyRecord (token: AEDesc; var result: AERecord): OSErr;
  72.  
  73.     function StorePropertyReferenceInToken (prop: DescType; container: AEDesc; var token: AEDesc): OSErr;
  74.     function RetrievePropertyReferenceFromToken (token: AEDesc; var prop: DescType; var container: AEDesc): OSErr;
  75.     function ValidProperty (class, prop: DescType): boolean;
  76.     function GetIndProperty (class: DescType; index: integer; var prop: DescType): boolean;
  77.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  78.  
  79.     function NullSuspendedEvent: SuspendedEvent;
  80.     function SuspendEvent (event, reply: AppleEvent; dispatcher: EventHandlerProcPtr; refcon: longInt; var se: SuspendedEvent): OSErr;
  81.     procedure ResumeEvent (var se: SuspendedEvent);
  82.  
  83. implementation
  84.  
  85.     uses
  86. {$IFC undefined THINK_Pascal}
  87.         Resources, 
  88. {$ENDC}
  89.         AEObjects, AERegistry, MyStrings;
  90.  
  91.     var
  92.         GetPropertyFromContainerProc: ProcPtr;
  93.         SetPropertyFromContainerProc: ProcPtr;
  94.  
  95.     function CallGetPropertyFromContainer (prop: DescType; container: AEDesc; var result: AEDesc; p: ptr): OSErr;
  96.     inline
  97.         $205F, $4E90;
  98.  
  99.     function CallSetPropertyFromContainer (prop: DescType; container: AEDesc; value: AEDesc; p: ptr): OSErr;
  100.     inline
  101.         $205F, $4E90;
  102.  
  103. {$S Init}
  104.     procedure InitAEUtils (GetPropertyFromContainer, SetPropertyFromContainer: ProcPtr);
  105.     begin
  106.         GetPropertyFromContainerProc := GetPropertyFromContainer;
  107.         SetPropertyFromContainerProc := SetPropertyFromContainer;
  108.     end;
  109. {$S}
  110.  
  111.     procedure AECreate (var desc: AEDesc);
  112.     begin
  113.         desc.descriptorType := typeNull;
  114.         desc.dataHandle := nil;
  115.     end;
  116.  
  117.     function AENull: AEDesc;
  118.         var
  119.             desc: AEDesc;
  120.     begin
  121.         AECreate(desc);
  122.         AENull := desc;
  123.     end;
  124.  
  125.     procedure AEDestroy (var desc: AEDesc);
  126.         var
  127.             junk: OSErr;
  128.     begin
  129.         junk := AEDisposeDesc(desc);
  130.         AECreate(desc);
  131.     end;
  132.  
  133.     function GotRequiredParams (theAppleEvent: AppleEvent): OSErr;
  134.         var
  135.             typeCode: DescType;
  136.             actualSize: Size;
  137.             err: OSErr;
  138.     begin
  139.         err := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);    { nil ok: need only function result }
  140.         if err = errAEDescNotFound then        { we got all the required params: all is ok }
  141.             GotRequiredParams := noErr
  142.         else if err = noErr then
  143.             GotRequiredParams := errAEEventNotHandled
  144.         else
  145.             GotRequiredParams := err;
  146.     end; { GotRequiredParams }
  147.  
  148.     function AEGetDescPtr (desc: AEDesc; desiredType: DescType; p: ptr; maximumSize: Size; var actualSize: Size): OSErr;
  149.         var
  150.             err: OSErr;
  151.             result: AEDesc;
  152.             len: longInt;
  153.     begin
  154.         actualSize := 0;
  155.         err := AECoerceDesc(desc, desiredType, result);
  156.         if err = noErr then begin
  157.             actualSize := GetHandleSize(result.dataHandle);
  158.             len := actualSize;
  159.             if len > maximumSize then
  160.                 len := maximumSize;
  161.             BlockMove(result.dataHandle^, p, len);
  162.         end;
  163.         AEDestroy(result);
  164.         AEGetDescPtr := err;
  165.     end;
  166.  
  167.     function CreateSelfTarget (var desc: AEDesc): OSErr;
  168.         var
  169.             psn: ProcessSerialNumber;
  170.     begin
  171.         psn.lowLongOfPSN := kCurrentProcess;
  172.         psn.highLongOfPSN := 0;
  173.         CreateSelfTarget := AECreateDesc(typeProcessSerialNumber, @psn, SizeOf(psn), desc);
  174.     end;
  175.  
  176.     function CreateStringDesc (s: str255; var desc: AEDesc): OSErr;
  177.     begin
  178.         CreateStringDesc := AECreateDesc(typeChar, @s[1], length(s), desc);
  179.     end;
  180.  
  181.     function CreateLongDesc (n: longInt; var desc: AEDesc): OSErr;
  182.     begin
  183.         CreateLongDesc := AECreateDesc(typeLongInteger, @n, SizeOf(n), desc);
  184.     end;
  185.  
  186.     function CreateTypeDesc (t: DescType; var desc: AEDesc): OSErr;
  187.     begin
  188.         CreateTypeDesc := AECreateDesc(typeType, @t, SizeOf(t), desc);
  189.     end;
  190.  
  191.     function CreateBooleanDesc (b: boolean; var desc: AEDesc): OSErr;
  192.     begin
  193.         CreateBooleanDesc := AECreateDesc(typeBoolean, @b, SizeOf(b), desc);
  194.     end;
  195.  
  196.     function CreateFSSpecDesc (fs: FSSpec; var desc: AEDesc): OSErr;
  197.     begin
  198.         CreateFSSpecDesc := AECreateDesc(typeFSS, @fs, SizeOf(fs), desc);
  199.     end;
  200.  
  201.     function GetStringFromAEDesc (desc: AEDesc; var x: str255): OSErr;
  202.         var
  203.             result: AEDesc;
  204.             err, junk: OSErr;
  205.     begin
  206.         err := AECoerceDesc(desc, typeChar, result);
  207.         if err = noErr then begin
  208.             HandleToString(result.dataHandle, x);
  209.             AEDestroy(result);
  210.         end;
  211.         GetStringFromAEDesc := err;
  212.     end;
  213.  
  214.     function GetLongFromAEDesc (desc: AEDesc; var x: longInt): OSErr;
  215.         var
  216.             len: longInt;
  217.             err: OSErr;
  218.             temp: longInt;
  219.     begin
  220.         err := AEGetDescPtr(desc, typeLongInteger, @temp, SizeOf(temp), len);
  221.         if err = noErr then
  222.             x := temp;
  223.         GetLongFromAEDesc := err;
  224.     end;
  225.  
  226.     function GetTypeFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  227.         var
  228.             len: longInt;
  229.             err: OSErr;
  230.             temp: DescType;
  231.     begin
  232.         err := AEGetDescPtr(desc, typeType, @temp, SizeOf(temp), len);
  233.         if err = noErr then
  234.             x := temp;
  235.         GetTypeFromAEDesc := err;
  236.     end;
  237.  
  238.     function GetBooleanFromAEDesc (desc: AEDesc; var x: boolean): OSErr;
  239.         var
  240.             len: longInt;
  241.             err: OSErr;
  242.             temp: boolean;
  243.     begin
  244.         err := AEGetDescPtr(desc, typeBoolean, @temp, SizeOf(temp), len);
  245.         if err = noErr then
  246.             x := temp;
  247.         GetBooleanFromAEDesc := err;
  248.     end;
  249.  
  250.     function GetFSSpecFromAEDesc (desc: AEDesc; var x: FSSpec): OSErr;
  251.         var
  252.             err: OSErr;
  253.             len: longInt;
  254.             temp: FSSpec;
  255.     begin
  256.         err := AEGetDescPtr(desc, typeFSS, @temp, SizeOf(temp), len);
  257.         if err = noErr then
  258.             x := temp;
  259.         GetFSSpecFromAEDesc := err;
  260.     end;
  261.  
  262.     function GetEnumeratedFromAEDesc (desc: AEDesc; var x: DescType): OSErr;
  263.         var
  264.             err: OSErr;
  265.     begin
  266.         err := noErr;
  267.         if (GetHandleSize(desc.dataHandle) <> SizeOf(DescType)) then begin
  268.             err := errAETypeError;
  269.         end;
  270.         if err = noErr then begin
  271.             BlockMove(desc.dataHandle^, @x, SizeOf(x));
  272.         end;
  273.         GetEnumeratedFromAEDesc := err;
  274.     end;
  275.  
  276.     function GetStringFromAERecord (desc: AERecord; key: AEKeyword; var x: str255): OSErr;
  277.         var
  278.             dummy: DescType;
  279.             actual: Size;
  280.             err: OSErr;
  281.             temp: str255;
  282.     begin
  283.         err := AEGetKeyPtr(desc, key, typeChar, dummy, @temp[1], 255, actual);
  284.         if err = noErr then begin
  285.             temp[0] := chr(actual);
  286.             x := temp;
  287.         end;
  288.         GetStringFromAERecord := err;
  289.     end;
  290.  
  291.     function GetLongFromAERecord (desc: AERecord; key: AEKeyword; var x: longInt): OSErr;
  292.         var
  293.             dummy: DescType;
  294.             actual: Size;
  295.             err: OSErr;
  296.             temp: longInt;
  297.     begin
  298.         err := AEGetKeyPtr(desc, key, typeLongInteger, dummy, @temp, SizeOf(temp), actual);
  299.         if err = noErr then
  300.             x := temp;
  301.         GetLongFromAERecord := err;
  302.     end;
  303.  
  304.     function GetTypeFromAERecord (desc: AERecord; key: AEKeyword; var x: DescType): OSErr;
  305.         var
  306.             dummy: DescType;
  307.             actual: Size;
  308.             err: OSErr;
  309.             temp: DescType;
  310.     begin
  311.         err := AEGetKeyPtr(desc, key, typeType, dummy, @temp, SizeOf(temp), actual);
  312.         if err = noErr then
  313.             x := temp;
  314.         GetTypeFromAERecord := err;
  315.     end;
  316.  
  317.     function GetBooleanFromAERecord (desc: AERecord; key: AEKeyword; var x: boolean): OSErr;
  318.         var
  319.             dummy: DescType;
  320.             actual: Size;
  321.             err: OSErr;
  322.             temp: boolean;
  323.     begin
  324.         err := AEGetKeyPtr(desc, key, typeBoolean, dummy, @temp, SizeOf(temp), actual);
  325.         if err = noErr then
  326.             x := temp;
  327.         GetBooleanFromAERecord := err;
  328.     end;
  329.  
  330.     function GetFSSpecFromAERecord (event: AppleEvent; key: AEKeyword; var x: FSSpec): OSErr;
  331.         var
  332.             dummy: DescType;
  333.             actual: Size;
  334.             err: OSErr;
  335.             temp: FSSpec;
  336.     begin
  337.         err := AEGetKeyPtr(event, key, typeFSS, dummy, @temp, SizeOf(temp), actual);
  338.         if err = noErr then
  339.             x := temp;
  340.         GetFSSpecFromAERecord := err;
  341.     end;
  342.  
  343.     function GetEnumeratedFromAERecord (event: AppleEvent; key: AEKeyword; var x: DescType): OSErr;
  344.         var
  345.             err: OSErr;
  346.             value: AEDesc;
  347.     begin
  348.         err := AEGetParamDesc(event, key, typeWildCard, value);
  349.         if err = noErr then begin
  350.             err := GetEnumeratedFromAEDesc(value, x);
  351.         end;
  352.         AEDestroy(value);
  353.         GetEnumeratedFromAERecord := err;
  354.     end;
  355.  
  356.     function PutTESelectionToAERecord (desc: AERecord; key: AEKeyword; te: TEHandle): OSErr;
  357.         var
  358.             h: handle;
  359.             state: SignedByte;
  360.     begin
  361.         h := handle(TEGetText(te));
  362.         state := HGetState(h);
  363.         HLock(h);
  364.         PutTESelectionToAERecord := AEPutKeyPtr(desc, key, typeChar, ptr(ord(h^) + te^^.selStart), te^^.selEnd - te^^.selStart);
  365.         HSetState(h, state);
  366.     end;
  367.  
  368.     function PutStringToAERecord (desc: AERecord; key: AEKeyword; s: str255): OSErr;
  369.     begin
  370.         PutStringToAERecord := AEPutKeyPtr(desc, key, typeChar, @s[1], length(s));
  371.     end;
  372.  
  373.     function PutLongToAERecord (desc: AERecord; key: AEKeyword; n: longInt): OSErr;
  374.     begin
  375.         PutLongToAERecord := AEPutKeyPtr(desc, key, typeLongInteger, @n, SizeOf(n));
  376.     end;
  377.  
  378.     function PutDateToAERecord (desc: AERecord; key: AEKeyword; date: longInt): OSErr;
  379.         var
  380.             longdate: record
  381.                     zero: longInt;
  382.                     date: longInt;
  383.                 end;
  384.     begin
  385.         longdate.zero := 0;
  386.         longdate.date := date;
  387.         PutDateToAERecord := AEPutKeyPtr(desc, key, 'ldt ', @longdate, SizeOf(longdate)); { typeLongDateTime }
  388.     end;
  389.  
  390.     function PutTypeToAERecord (desc: AERecord; key: AEKeyword; t: DescType): OSErr;
  391.     begin
  392.         PutTypeToAERecord := AEPutKeyPtr(desc, key, typeType, @t, SizeOf(t));
  393.     end;
  394.  
  395.     function PutBooleanToAERecord (desc: AERecord; key: AEKeyword; b: boolean): OSErr;
  396.     begin
  397.         PutBooleanToAERecord := AEPutKeyPtr(desc, key, typeBoolean, @b, SizeOf(b));
  398.     end;
  399.  
  400.     function PutFSSpecToAERecord (desc: AppleEvent; key: AEKeyword; fs: FSSpec): OSErr;
  401.     begin
  402.         PutFSSpecToAERecord := AEPutKeyPtr(desc, key, typeFSS, @fs, SizeOf(fs));
  403.     end;
  404.  
  405.     function StorePropertyReferenceInToken (prop: DescType; container: AEDesc; var token: AEDesc): OSErr;
  406.         var
  407.             h: handle;
  408.             err: OSErr;
  409.     begin
  410.         h := nil;
  411.         err := PtrToHand(@prop, h, SizeOf(DescType));
  412.         if err = noErr then
  413.             err := PtrAndHand(@container.descriptorType, h, SizeOf(DescType));
  414.         if err = noErr then
  415.             err := HandAndHand(container.dataHandle, h);
  416.         if err = noErr then begin
  417.             HLock(h);
  418.             err := AECreateDesc(typeMyPropertyToken, h^, GetHandleSize(h), token);
  419.         end;
  420.         DisposeHandle(h);
  421.         StorePropertyReferenceInToken := err;
  422.     end;
  423.  
  424.     function RetrievePropertyReferenceFromToken (token: AEDesc; var prop: DescType; var container: AEDesc): OSErr;
  425.         var
  426.             conttype: DescType;
  427.             err: OSErr;
  428.     begin
  429.         BlockMove(token.dataHandle^, @prop, SizeOf(DescType));
  430.         BlockMove(ptr(ord(token.dataHandle^) + SizeOf(DescType)), @conttype, SizeOf(DescType));
  431.         HLock(token.dataHandle);
  432.         err := AECreateDesc(conttype, ptr(ord(token.dataHandle^) + 2 * SizeOf(DescType)), GetHandleSize(token.dataHandle) - 2 * SizeOf(DescType), container);
  433.         HUnlock(token.dataHandle);
  434.         if err <> noErr then begin
  435.             AECreate(container);
  436.         end;
  437.         RetrievePropertyReferenceFromToken := err;
  438.     end;
  439.  
  440.     type
  441.         propertiesRecord = record
  442.                 count: integer;
  443.                 props: array[1..1000] of DescType;
  444.             end;
  445.         propertiesRecordPtr = ^propertiesRecord;
  446.         propertiesRecordHandle = ^propertiesRecordPtr;
  447.  
  448.     function OSTypeToString (ost: OSType): Str15;
  449.         var
  450.             s: str15;
  451.     begin
  452.         s[0] := chr(4);
  453.         BlockMove(@ost, @s[1], 4);
  454.         OSTypeToString := s;
  455.     end;
  456.  
  457.     function GetIndProperty (class: DescType; index: integer; var prop: DescType): boolean;
  458.         var
  459.             h: propertiesRecordHandle;
  460.     begin
  461.         h := propertiesRecordHandle(GetNamedResource(myPropertiesResType, OSTypeToString(class)));
  462.         GetIndProperty := false;
  463.         if h <> nil then begin
  464.             if (0 < index) & (index <= h^^.count) then begin
  465.                 prop := h^^.props[index];
  466.                 GetIndProperty := true;
  467.             end;
  468.             HPurge(handle(h));
  469.         end;
  470.     end;
  471.  
  472.     function ValidProperty (class, prop: DescType): boolean;
  473.         var
  474.             h: propertiesRecordHandle;
  475.             i: integer;
  476.     begin
  477.         h := propertiesRecordHandle(GetNamedResource(myPropertiesResType, OSTypeToString(class)));
  478.         ValidProperty := false;
  479.         if h <> nil then begin
  480.             for i := 1 to h^^.count do begin
  481.                 if h^^.props[i] = prop then begin
  482.                     ValidProperty := true;
  483.                     leave;
  484.                 end;
  485.             end;
  486.             HPurge(handle(h));
  487.         end;
  488.     end;
  489.  
  490.     function MyOAFindProperty (desiredClass: DescType; containerToken: AEDesc; containerClass: DescType; keyForm: DescType; keyData: AEDesc; var token: AEDesc; refcon: LongInt): OSErr;
  491.         var
  492.             err: OSErr;
  493.             prop: DescType;
  494.     begin
  495.         if keyForm = formPropertyID then begin
  496.             err := GetTypeFromAEDesc(keyData, prop);
  497.             if err = noErr then begin
  498.                 if ValidProperty(containerToken.descriptorType, prop) then begin
  499.                     err := StorePropertyReferenceInToken(prop, containerToken, token);
  500.                 end
  501.                 else begin
  502.                     err := errAENoSuchObject;
  503.                 end;
  504.             end;
  505.         end
  506.         else begin
  507.             err := errAEBadKeyForm;
  508.         end;
  509.         MyOAFindProperty := err;
  510.     end;
  511.  
  512.     function SetPropertyFromToken (token: AEDesc; value: AEDesc): OSErr;
  513.         var
  514.             err, junk: OSErr;
  515.             prop: DescType;
  516.             container: AEDesc;
  517.     begin
  518.         err := RetrievePropertyReferenceFromToken(token, prop, container);
  519.         if err = noErr then begin
  520.             err := CallSetPropertyFromContainer(prop, container, value, SetPropertyFromContainerProc);
  521.         end;
  522.         AEDestroy(container);
  523.         SetPropertyFromToken := err;
  524.     end;
  525.  
  526.     function SetPropertyRecord (token: AEDesc; value: AEDesc): OSErr;
  527.         var
  528.             index: integer;
  529.             prop: DescType;
  530.             element: AEDesc;
  531.             err, junk: OSErr;
  532.     begin
  533.         index := 1;
  534.         while (err = noErr) & GetIndProperty(token.descriptorType, index, prop) do begin
  535.             err := AEGetKeyDesc(value, prop, typeWildCard, element);
  536.             if err = noErr then begin
  537.                 err := CallSetPropertyFromContainer(prop, token, element, SetPropertyFromContainerProc);
  538.                 AEDestroy(element);
  539.             end
  540.             else if err = errAEDescNotFound then begin
  541.                 err := noErr;
  542.             end;
  543.             index := index + 1;
  544.         end;
  545.         SetPropertyRecord := err;
  546.     end;
  547.  
  548.     function GetPropertyFromToken (token: AEDesc; var result: AEDesc): OSErr;
  549.         var
  550.             err, junk: OSErr;
  551.             prop: DescType;
  552.             container: AEDesc;
  553.     begin
  554.         err := RetrievePropertyReferenceFromToken(token, prop, container);
  555.         if err = noErr then begin
  556.             err := CallGetPropertyFromContainer(prop, container, result, GetPropertyFromContainerProc);
  557.         end;
  558.         AEDestroy(container);
  559.         GetPropertyFromToken := err;
  560.     end;
  561.  
  562.     function GetPropertyRecord (token: AEDesc; var result: AERecord): OSErr;
  563.         var
  564.             index: integer;
  565.             prop: DescType;
  566.             element: AEDesc;
  567.             err, junk: OSErr;
  568.     begin
  569.         err := AECreateList(nil, 0, true, result);
  570.         index := 1;
  571.         while (err = noErr) & GetIndProperty(token.descriptorType, index, prop) do begin
  572.             err := CallGetPropertyFromContainer(prop, token, element, GetPropertyFromContainerProc);
  573.             if err = noErr then begin
  574.                 err := AEPutKeyDesc(result, prop, element);
  575.                 AEDestroy(element);
  576.             end
  577.             else if err = errAEReadDenied then begin
  578.                 err := noErr;
  579.             end;
  580.             index := index + 1;
  581.         end;
  582.         if err <> noErr then begin
  583.             AEDestroy(result);
  584.         end;
  585.         GetPropertyRecord := err;
  586.     end;
  587.  
  588.     procedure SendSelfSimpleEvent (class_id, event_id: AEEventID);
  589.         var
  590.             event, reply: AppleEvent;
  591.             err, junk: OSErr;
  592.             psn: ProcessSerialNumber;
  593.             target: AEDesc;
  594.     begin
  595.         AECreate(reply);
  596.         err := CreateSelfTarget(target);
  597.         err := AECreateAppleEvent(class_id, event_id, target, kAutoGenerateReturnID, kAnyTransactionID, event);
  598.         AEDestroy(target);
  599.         if err = noErr then begin
  600.             junk := AESend(event, reply, kAENoReply + kAEAlwaysInteract, kAENormalPriority, kAEDefaultTimeOut, nil, nil);
  601.         end;
  602.         AEDestroy(event);
  603.         AEDestroy(reply);
  604.     end;
  605.  
  606.     function NullSuspendedEvent: SuspendedEvent;
  607.         var
  608.             se: SuspendedEvent;
  609.     begin
  610.         se.waiting := false;
  611.         NullSuspendedEvent := se;
  612.     end;
  613.  
  614.     function SuspendEvent (event, reply: AppleEvent; dispatcher: EventHandlerProcPtr; refcon: longInt; var se: SuspendedEvent): OSErr;
  615.         var
  616.             err: OSErr;
  617.     begin
  618.         se.event := event;
  619.         se.reply := reply;
  620.         se.dispatcher := dispatcher;
  621.         se.refcon := refcon;
  622.         err := AESuspendTheCurrentEvent(event);
  623.         se.waiting := err = noErr;
  624.         SuspendEvent := err;
  625.     end;
  626.  
  627.     procedure ResumeEvent (var se: SuspendedEvent);
  628.         var
  629.             junk: OSErr;
  630.     begin
  631.         if se.waiting then begin
  632.             se.waiting := false;
  633.             junk := AEResumeTheCurrentEvent(se.event, se.reply, se.dispatcher, se.refcon);
  634.         end;
  635.     end;
  636.  
  637. end.